Subida de datos y primeras observaciones

  1. Primeramente subimos los datos que se encuentran en formato csv, y observamos la cabecera de los mismos.
data <- read.csv("./archive/accepted_2007_to_2018q4.csv/accepted_2007_to_2018Q4.csv")
head(data[1:5,1:10])
##         id member_id loan_amnt funded_amnt funded_amnt_inv       term int_rate
## 1 68407277        NA      3600        3600            3600  36 months    13.99
## 2 68355089        NA     24700       24700           24700  36 months    11.99
## 3 68341763        NA     20000       20000           20000  60 months    10.78
## 4 66310712        NA     35000       35000           35000  60 months    14.85
## 5 68476807        NA     10400       10400           10400  60 months    22.45
##   installment grade sub_grade
## 1      123.03     C        C4
## 2      820.28     C        C1
## 3      432.66     B        B4
## 4      829.90     C        C5
## 5      289.91     F        F1
summary(data[,1:10])
##       id            member_id        loan_amnt      funded_amnt   
##  Length:2260701     Mode:logical   Min.   :  500   Min.   :  500  
##  Class :character   NA's:2260701   1st Qu.: 8000   1st Qu.: 8000  
##  Mode  :character                  Median :12900   Median :12875  
##                                    Mean   :15047   Mean   :15042  
##                                    3rd Qu.:20000   3rd Qu.:20000  
##                                    Max.   :40000   Max.   :40000  
##                                    NA's   :33      NA's   :33     
##  funded_amnt_inv     term              int_rate      installment     
##  Min.   :    0   Length:2260701     Min.   : 5.31   Min.   :   4.93  
##  1st Qu.: 8000   Class :character   1st Qu.: 9.49   1st Qu.: 251.65  
##  Median :12800   Mode  :character   Median :12.62   Median : 377.99  
##  Mean   :15023                      Mean   :13.09   Mean   : 445.81  
##  3rd Qu.:20000                      3rd Qu.:15.99   3rd Qu.: 593.32  
##  Max.   :40000                      Max.   :30.99   Max.   :1719.83  
##  NA's   :33                         NA's   :33      NA's   :33       
##     grade            sub_grade        
##  Length:2260701     Length:2260701    
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
##                                       
## 
dim(data)
## [1] 2260701     151
num_qualitative <- sum(sapply(data, function(x) is.factor(x) | is.character(x)))

num_quantitative <- sum(sapply(data, is.numeric))

cat("Número de variables cualitativas:", num_qualitative, "\n")
## Número de variables cualitativas: 38
cat("Número de variables cuantitativas:", num_quantitative, "\n")
## Número de variables cuantitativas: 112
cat("Número total de variables:", ncol(data), "\n")
## Número total de variables: 151

Lo que se vemos es que disponemos de un dataset de dimensiones bastante grandes, concretamente tenemos 2,260,701 muestras y 151 variables. De entre estas últimas, tenemos de 38 variables cualitativas y 112 cuantitativas, además de una variable lógica.

1.1. Exploración de los nombres de las columnas y revisión de datos faltantes.

missing_values <- colSums(is.na(data))
missing_percentage <- round((missing_values / nrow(data)) * 100, 2)  
missing_data <- data.frame(
  Missing_Count = missing_values,
  Missing_Percent = missing_percentage
)
missing_data[missing_data$Missing_Count > 0, ]
##                                            Missing_Count Missing_Percent
## member_id                                        2260701          100.00
## loan_amnt                                             33            0.00
## funded_amnt                                           33            0.00
## funded_amnt_inv                                       33            0.00
## int_rate                                              33            0.00
## installment                                           33            0.00
## annual_inc                                            37            0.00
## dti                                                 1744            0.08
## delinq_2yrs                                           62            0.00
## fico_range_low                                        33            0.00
## fico_range_high                                       33            0.00
## inq_last_6mths                                        63            0.00
## mths_since_last_delinq                           1158535           51.25
## mths_since_last_record                           1901545           84.11
## open_acc                                              62            0.00
## pub_rec                                               62            0.00
## revol_bal                                             33            0.00
## revol_util                                          1835            0.08
## total_acc                                             62            0.00
## out_prncp                                             33            0.00
## out_prncp_inv                                         33            0.00
## total_pymnt                                           33            0.00
## total_pymnt_inv                                       33            0.00
## total_rec_prncp                                       33            0.00
## total_rec_int                                         33            0.00
## total_rec_late_fee                                    33            0.00
## recoveries                                            33            0.00
## collection_recovery_fee                               33            0.00
## last_pymnt_amnt                                       33            0.00
## last_fico_range_high                                  33            0.00
## last_fico_range_low                                   33            0.00
## collections_12_mths_ex_med                           178            0.01
## mths_since_last_major_derog                      1679926           74.31
## policy_code                                           33            0.00
## annual_inc_joint                                 2139991           94.66
## dti_joint                                        2139995           94.66
## acc_now_delinq                                        62            0.00
## tot_coll_amt                                       70309            3.11
## tot_cur_bal                                        70309            3.11
## open_acc_6m                                       866163           38.31
## open_act_il                                       866162           38.31
## open_il_12m                                       866162           38.31
## open_il_24m                                       866162           38.31
## mths_since_rcnt_il                                909957           40.25
## total_bal_il                                      866162           38.31
## il_util                                          1068883           47.28
## open_rv_12m                                       866162           38.31
## open_rv_24m                                       866162           38.31
## max_bal_bc                                        866162           38.31
## all_util                                          866381           38.32
## total_rev_hi_lim                                   70309            3.11
## inq_fi                                            866162           38.31
## total_cu_tl                                       866163           38.31
## inq_last_12m                                      866163           38.31
## acc_open_past_24mths                               50063            2.21
## avg_cur_bal                                        70379            3.11
## bc_open_to_buy                                     74968            3.32
## bc_util                                            76104            3.37
## chargeoff_within_12_mths                             178            0.01
## delinq_amnt                                           62            0.00
## mo_sin_old_il_acct                                139104            6.15
## mo_sin_old_rev_tl_op                               70310            3.11
## mo_sin_rcnt_rev_tl_op                              70310            3.11
## mo_sin_rcnt_tl                                     70309            3.11
## mort_acc                                           50063            2.21
## mths_since_recent_bc                               73445            3.25
## mths_since_recent_bc_dlq                         1741000           77.01
## mths_since_recent_inq                             295468           13.07
## mths_since_recent_revol_delinq                   1520342           67.25
## num_accts_ever_120_pd                              70309            3.11
## num_actv_bc_tl                                     70309            3.11
## num_actv_rev_tl                                    70309            3.11
## num_bc_sats                                        58623            2.59
## num_bc_tl                                          70309            3.11
## num_il_tl                                          70309            3.11
## num_op_rev_tl                                      70309            3.11
## num_rev_accts                                      70310            3.11
## num_rev_tl_bal_gt_0                                70309            3.11
## num_sats                                           58623            2.59
## num_tl_120dpd_2m                                  153690            6.80
## num_tl_30dpd                                       70309            3.11
## num_tl_90g_dpd_24m                                 70309            3.11
## num_tl_op_past_12m                                 70309            3.11
## pct_tl_nvr_dlq                                     70464            3.12
## percent_bc_gt_75                                   75412            3.34
## pub_rec_bankruptcies                                1398            0.06
## tax_liens                                            138            0.01
## tot_hi_cred_lim                                    70309            3.11
## total_bal_ex_mort                                  50063            2.21
## total_bc_limit                                     50063            2.21
## total_il_high_credit_limit                         70309            3.11
## revol_bal_joint                                  2152681           95.22
## sec_app_fico_range_low                           2152680           95.22
## sec_app_fico_range_high                          2152680           95.22
## sec_app_inq_last_6mths                           2152680           95.22
## sec_app_mort_acc                                 2152680           95.22
## sec_app_open_acc                                 2152680           95.22
## sec_app_revol_util                               2154517           95.30
## sec_app_open_act_il                              2152680           95.22
## sec_app_num_rev_accts                            2152680           95.22
## sec_app_chargeoff_within_12_mths                 2152680           95.22
## sec_app_collections_12_mths_ex_med               2152680           95.22
## sec_app_mths_since_last_major_derog              2224759           98.41
## deferral_term                                    2249784           99.52
## hardship_amount                                  2249784           99.52
## hardship_length                                  2249784           99.52
## hardship_dpd                                     2249784           99.52
## orig_projected_additional_accrued_interest       2252050           99.62
## hardship_payoff_balance_amount                   2249784           99.52
## hardship_last_payment_amount                     2249784           99.52
## settlement_amount                                2226455           98.49
## settlement_percentage                            2226455           98.49
## settlement_term                                  2226455           98.49

Comprobamos los nombres de las variables a las que nos enfrentamos, y además calculamos el porcentaje y número de valores perdidos en cada una de esas variables. Hay varias variables que contienen un gran número de valores perdidos, los cuales filtraremos en pasos subsiguientes.

1.2. Filtrado de columnas con muchos datos faltantes.

Eliminamos las columnas que tienen más del 50% de datos faltantes.

threshold <- 0.5 * nrow(data)
columns_before <- ncol(data)

column_names_before <- colnames(data)
data <- data[, colSums(is.na(data)) <= threshold]

columns_after <- ncol(data)
column_names_after <- colnames(data)
eliminated_columns <- setdiff(column_names_before, column_names_after)

cat("Eliminadas", columns_before - columns_after, "columnas con más de un 50% de valores perdidos.\n")
## Eliminadas 30 columnas con más de un 50% de valores perdidos.
cat("Columnas eliminadas:\n", paste(eliminated_columns, collapse = ", "), "\n")
## Columnas eliminadas:
##  member_id, mths_since_last_delinq, mths_since_last_record, mths_since_last_major_derog, annual_inc_joint, dti_joint, mths_since_recent_bc_dlq, mths_since_recent_revol_delinq, revol_bal_joint, sec_app_fico_range_low, sec_app_fico_range_high, sec_app_inq_last_6mths, sec_app_mort_acc, sec_app_open_acc, sec_app_revol_util, sec_app_open_act_il, sec_app_num_rev_accts, sec_app_chargeoff_within_12_mths, sec_app_collections_12_mths_ex_med, sec_app_mths_since_last_major_derog, deferral_term, hardship_amount, hardship_length, hardship_dpd, orig_projected_additional_accrued_interest, hardship_payoff_balance_amount, hardship_last_payment_amount, settlement_amount, settlement_percentage, settlement_term

Como vimos en el paso anterior, había variables con muchos valores perdidos, de modo que hemos decidido filtrar las variables que tengan en concreto más del 50% de valores faltantes, que son 30. Vemos las variables filtradas, para no eliminar alguna que resultara de interés a pesar de que la información recopilada de ellas fuera muy poca.

member_id: Un identificador único para cada prestatario en el conjunto de datos. Es una referencia al prestatario dentro del sistema de Lending Club.

mths_since_last_delinq: Número de meses desde la última morosidad (delinquency). Indica cuánto tiempo ha pasado desde que el prestatario no pagó una deuda a tiempo.

mths_since_last_record: Número de meses desde el último registro público (como una bancarrota o una demanda judicial). Si está en blanco, el prestatario no tiene registros públicos recientes.

mths_since_last_major_derog: Número de meses desde la última falta importante en el crédito (derogatory mark), como un cobro grave o una morosidad severa.

annual_inc_joint: Ingreso anual combinado si hay un co-solicitante en el préstamo (como un cónyuge o pareja).

dti_joint: Relación deuda-ingresos (DTI) combinada, que es el porcentaje de los ingresos combinados del solicitante y el co-solicitante destinado a pagar deudas.

mths_since_recent_bc_dlq: Número de meses desde la última morosidad en una línea de crédito rotativo (como una tarjeta de crédito).

mths_since_recent_revol_delinq: Número de meses desde la última morosidad en una cuenta de crédito revolvente (deuda que se puede volver a utilizar después de pagar, como tarjetas de crédito).

revol_bal_joint: Saldo revolvente combinado del solicitante y co-solicitante.

sec_app_fico_range_low: Puntuación FICO mínima del co-solicitante.

sec_app_fico_range_high: Puntuación FICO máxima del co-solicitante.

sec_app_inq_last_6mths: Número de consultas crediticias (hard inquiries) realizadas en los últimos 6 meses para el co-solicitante.

sec_app_mort_acc: Número de cuentas hipotecarias abiertas asociadas al co-solicitante.

sec_app_open_acc: Número total de cuentas abiertas del co-solicitante.

sec_app_revol_util: Utilización de crédito revolvente del co-solicitante (porcentaje de crédito utilizado del total disponible).

sec_app_open_act_il: Número de cuentas activas de crédito a plazos abiertas del co-solicitante.

sec_app_num_rev_accts: Número de cuentas de crédito revolvente del co-solicitante.

sec_app_chargeoff_within_12_mths: Número de cuentas cargadas como pérdida (charge-offs) en los últimos 12 meses para el co-solicitante.

sec_app_collections_12_mths_ex_med: Número de cuentas en colecciones (excluyendo cuentas médicas) del co-solicitante en los últimos 12 meses.

sec_app_mths_since_last_major_derog: Número de meses desde la última falta importante en el crédito del co-solicitante.

deferral_term: Número de meses en los que el pago del préstamo se ha diferido (aplazado).

hardship_amount: Cantidad mensual de pago reducida durante un período de dificultad financiera (hardship).

hardship_length: Duración del período de dificultad financiera (en meses).

hardship_dpd: Número de días en mora (days past due) durante un período de dificultad financiera.

orig_projected_additional_accrued_interest: Cantidad original de interés adicional proyectado que se acumulará debido al aplazamiento del pago.

hardship_payoff_balance_amount: Saldo pendiente que debe pagarse al final del período de dificultad financiera.

hardship_last_payment_amount: Última cantidad de pago realizada durante el período de dificultad financiera.

settlement_amount: Monto acordado en un acuerdo de liquidación para pagar menos de lo que se debe originalmente.

settlement_percentage: Porcentaje del saldo original del préstamo que se acordó pagar en el acuerdo de liquidación.

settlement_term: Duración del acuerdo de liquidación en meses.

A pesar de que hay alguna variable que pueda resultar relevante, procederemos a continuar limpiando, analizando y construyendo nuestro modelo sin ellas. En caso de no ser capaces de llegar a una precisión alta en el modelo construído, podremos acudir a rescatar algunas de ellas. Quizás recopilar información acerca de estas variables sea más complejo o no es viable en muchos casos y es por ello que optamos por seguir, en principio, sin ellas.

1.3. Eliminación de variables con poca variabilidad.

Eliminamos las variables que tienen escasa variabilidad.

num_cores <- detectCores() - 1  

check_nzv <- function(col) {
  nzv_result <- nearZeroVar(data.frame(col), saveMetrics = TRUE)
  return(nzv_result$nzv)
}

columns_before <- ncol(data)

nzv_results <- unlist(mclapply(data, check_nzv, mc.cores = num_cores))

removed_columns <- names(data)[nzv_results]  # Nombres de columnas eliminadas
data <- data[, !nzv_results]

columns_after <- ncol(data)

cat("Removed", columns_before - columns_after, "columns with near-zero variance.\n")
## Removed 36 columns with near-zero variance.
cat("Columns removed:", paste(removed_columns, collapse = ", "), "\n")
## Columns removed: pymnt_plan, desc, revol_bal, total_rec_late_fee, recoveries, collection_recovery_fee, collections_12_mths_ex_med, policy_code, verification_status_joint, acc_now_delinq, tot_coll_amt, total_bal_il, max_bal_bc, chargeoff_within_12_mths, delinq_amnt, num_tl_120dpd_2m, num_tl_30dpd, num_tl_90g_dpd_24m, pct_tl_nvr_dlq, tax_liens, total_bal_ex_mort, total_il_high_credit_limit, sec_app_earliest_cr_line, hardship_flag, hardship_type, hardship_reason, hardship_status, hardship_start_date, hardship_end_date, payment_plan_start_date, hardship_loan_status, disbursement_method, debt_settlement_flag, debt_settlement_flag_date, settlement_status, settlement_date

Hacemos uso de la función nearZeroVar para este filtrado de variables con escasa variabilidad y que por tanto no nos aportarán información relevante para el estudio que llevaremos a cabo. Con este filtrado eliminamos 36 variables más, quedando aún 85. En este caso optamos por llevar a cabo una paralelización del proceso, acelerando el cálculo e implementando el uso de memoria. Las variables eliminadas son:

pymnt_plan: Indica si el prestatario está en un plan de pago especial (valor típico: n para no, y para sí).

desc: Descripción del propósito del préstamo escrita por el prestatario (puede contener texto libre).

revol_bal: Saldo total en cuentas de crédito revolvente (como tarjetas de crédito).

total_rec_late_fee: Total de cargos por pagos atrasados recibidos en el préstamo.

recoveries: Monto recuperado después de un cobro fallido o carga como pérdida (charge-off)

collection_recovery_fee: Tarifa asociada con la recuperación de fondos de cobros fallidos.

collections_12_mths_ex_med: Número de cuentas en colecciones (excluyendo cuentas médicas) en los últimos 12 meses.

policy_code: Código interno que describe la política de suscripción del préstamo. Los valores típicos son 1 (préstamos estándar) o 2 (préstamos personalizados).

verification_status_joint: Estado de verificación de ingresos para prestatarios conjuntos.

acc_now_delinq: Número de cuentas actualmente en mora del prestatario.

tot_coll_amt: Monto total de deudas en colecciones para el prestatario.

total_bal_il: Saldo total de cuentas de crédito a plazos (como préstamos personales o automotrices).

max_bal_bc: Saldo máximo registrado en cuentas de crédito revolvente.

chargeoff_within_12_mths: Número de cuentas cargadas como pérdida en los últimos 12 meses.

delinq_amnt: Monto total de morosidad en todas las cuentas del prestatario.

num_tl_120dpd_2m: Número de cuentas que han estado 120 días en mora en los últimos dos meses.

num_tl_30dpd: Número de cuentas con morosidad de 30 días en el historial crediticio.

num_tl_90g_dpd_24m: Número de cuentas con morosidad de 90 días o más en los últimos 24 meses.

pct_tl_nvr_dlq: Porcentaje de cuentas del prestatario que nunca han estado en mora.

tax_liens: Número de embargos fiscales registrados contra el prestatario.

total_bal_ex_mort: Saldo total en todas las cuentas del prestatario, excluyendo hipotecas.

total_il_high_credit_limit: Límite de crédito más alto en cuentas a plazos.

sec_app_earliest_cr_line: Fecha de apertura de la cuenta más antigua del co-solicitante.

hardship_flag: Indica si el prestatario está enfrentando dificultades financieras (Y para sí, N para no).

hardship_type: Tipo de dificultad financiera (por ejemplo, desempleo, reducción de ingresos).

hardship_reason: Razón específica para la dificultad financiera (por ejemplo, "pérdida de empleo").

hardship_status: Estado del proceso de dificultad financiera (aprobado, pendiente, etc.).

hardship_start_date: Fecha de inicio del período de dificultad financiera.

hardship_end_date: Fecha de finalización del período de dificultad financiera.

payment_plan_start_date: Fecha de inicio de un plan de pagos asociado con una dificultad financiera.

hardship_loan_status: Estado del préstamo durante el período de dificultad financiera.

disbursement_method: Método de desembolso del préstamo (por ejemplo, "DirectPay").

debt_settlement_flag: Indica si el prestatario ha entrado en un acuerdo de liquidación de deuda (Y para sí, N para no).

debt_settlement_flag_date: Fecha en la que se marcó el préstamo como sujeto a liquidación de deuda.

settlement_status: Estado del acuerdo de liquidación (por ejemplo, completado, pendiente).

settlement_date: Fecha en la que se completó el acuerdo de liquidación.

1.4. Visualización de la distribución de datos con Principal Component Analysis (PCA).

Llevamos a cabo un análsis de componentes principales para ver la tendencia de agrupación de las muestras.

num_cores <- detectCores() - 1  
cl <- makeCluster(num_cores)   
registerDoParallel(cl)          

numeric_data <- data[sapply(data, is.numeric)]

imputed_data <- foreach(i = 1:ncol(numeric_data), .combine = cbind) %dopar% {
  col <- numeric_data[[i]]
  ifelse(is.na(col), mean(col, na.rm = TRUE), col)
}

imputed_data <- as.data.frame(imputed_data)
colnames(imputed_data) <- colnames(numeric_data)

pca_result <- prcomp(imputed_data, scale. = TRUE)

pca_data <- data.frame(
  PC1 = pca_result$x[, 1],
  PC2 = pca_result$x[, 2],
  loan_status = data$loan_status
)

ggplot(pca_data, aes(x = PC1, y = PC2, color = loan_status)) +
  geom_point(size = 2) +
  labs(
    title = "PCA",
    x = "Componente Principal 1",
    y = "Componente Principal 2"
  ) +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    legend.text = element_text(size = 5),      
    legend.title = element_text(size = 6)         
  )

stopCluster(cl)

Consecuencia del gran número de muestras presentes en el set de datos, se hace muy difícil obtener resultados de agrupación relevantes al respecto de este PCA.

  1. Análisis Univariado.

2.1. Distribución de las variables numéricas.

Visualizamos la distribución de algunas variables numéricas seleccionadas para tener una idea de la dispersión de los datos.

numeric_vars <- names(data)[sapply(data, is.numeric)]
for (var in numeric_vars[1:10]) {
  print(ggplot(data, aes_string(x = var)) + 
          geom_histogram(fill = "blue", color = "black", bins = 30) + 
          labs(title = paste("Distribución de", var), x = var, y = "Frecuencia"))
}

Con estos plots, vamos viendo la tendencia o dispersión de estas variables numéricas. Si bien no podemos extraer conclusiones relevantes aún, convenía ver de forma visual a qué datos nos enfrentamos y cómo se distrubuyen.

2.2. Análisis de variables categóricas.

Visualizamos la distribución de algunas variables categóricas.

data <- data %>%
  mutate(across(where(is.character), as.factor))
categorical_vars <- names(data)[sapply(data, is.factor)]
for (var in categorical_vars[1:10]) {
  if (length(levels(data[[var]])) > 10) {
    top_levels <- names(sort(table(data[[var]]), decreasing = TRUE)[1:10])
    data[[paste0(var, "_top10")]] <- factor(ifelse(data[[var]] %in% top_levels, as.character(data[[var]]), "Other"))
    var <- paste0(var, "_top10")
  }
  
  p <- ggplot(data, aes_string(x = var)) + 
    geom_bar(fill = "orange", color = "black") + 
    labs(title = paste("Distribución de", var), x = var, y = "Frecuencia") + 
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  print(p)
}

Con todos estos plots ya nos vamos haciendo una gran idea de cómo se distribuyen las distintas variables numéricas y categóricas, y del tipo de datos e información de la que disponemos. Al igual que se comentó antes acerca de las variables numéricas, no podemos extraer conclusiones relevantes acerca de estos plots, si bien, hemos detectado la variable categórica que será nuestro "target", es decir, loan_status. Con esta variable sabemos si un cliente ha llevado a cabo el pago, el plazo en el que lo ha hecho o si por el contrario, no cumplió con él.

  1. Análisis Bivariado.

3.1. Análisis de correlación entre variables numéricas.

Calculamos la matriz de correlación y visualizamos un mapa de calor para identificar relaciones entre variables.

cor_matrix <- cor(data[, sapply(data, is.numeric)], use = "pairwise.complete.obs")
high_cor <- findCorrelation(cor_matrix, cutoff = 0.7)
cor_matrix_high <- cor_matrix[high_cor, high_cor]

corrplot(cor_matrix_high, method = "color", type = "upper", 
         tl.col = "black", tl.srt = 45, tl.cex = 0.55,
         col = colorRampPalette(c("red", "white", "blue"))(200),
         title = "High Correlation Matrix Heatmap", mar = c(0, 0, 1, 0))

Las variables relacionadas con el monto y los pagos del préstamo (loan_amnt, funded_amnt, total_pymnt) tienen correlaciones altas entre sí, lo que refleja su relación directa en el ciclo del préstamo.

Variables relacionadas con la utilización de crédito (revol_util, bc_util) están correlacionadas entre sí y negativamente con el puntaje FICO (fico_range_high), indicando que prestatarios con mayor solvencia financiera tienden a utilizar menos crédito.

out_prncp (capital pendiente) está inversamente relacionado con los pagos totales (total_pymnt) y está más relacionado con el progreso del préstamo que con las características del prestatario.

De forma más específica, podemos ver lo siguiente:

loan_amnt (Monto del préstamo):

Alta correlación positiva con funded_amnt y funded_amnt_inv. Esto es lógico porque estos valores están directamente relacionados con el monto solicitado y financiado. Correlación moderada con total_pymnt y total_pymnt_inv, lo que sugiere que préstamos más altos tienden a generar pagos totales más grandes.

total_pymnt (Total pagado por el prestatario):

Muy alta correlación con total_pymnt_inv, ya que ambas variables representan el mismo concepto (pagos totales realizados) pero desde perspectivas ligeramente diferentes. Correlación moderada con loan_amnt y funded_amnt, lo que refuerza que préstamos más grandes tienden a requerir mayores pagos.

fico_range_high (Rango alto de FICO):

Correlación negativa moderada con revol_util (utilización del crédito revolvente). Los prestatarios con puntajes FICO más altos suelen tener una menor utilización de crédito. Ligera correlación positiva con tot_hi_cred_lim, ya que los prestatarios con mejores puntajes FICO tienden a tener mayores límites de crédito.

revol_util (Utilización del crédito revolvente):

Correlación positiva con bc_util (utilización de tarjetas de crédito) y tot_cur_bal (saldo total actual), lo que refleja que estas variables están relacionadas con la carga de deuda actual del prestatario. Ligera correlación negativa con variables como fico_range_high, indicando que prestatarios más solventes tienden a usar menos crédito.

out_prncp (Saldo pendiente de capital):

Correlación negativa alta con total_pymnt, ya que a medida que el prestatario paga más, el saldo pendiente de capital disminuye. Correlación moderada con last_fico_range_high, sugiriendo que prestatarios con mejor historial pueden reducir más rápido su saldo.

3.2. Relación entre la variable objetivo y otras variables.

Creamos visualizaciones para explorar la relación entre la variable objetivo y otras variables.

important_vars <- c("last_fico_range_high", "last_fico_range_low", "last_pymnt_amnt", 
                    "total_rec_prncp", "out_prncp", "total_pymnt", "funded_amnt", 
                    "loan_amnt", "installment", "int_rate")

for (var in important_vars) {
  p <- ggplot(data, aes(x = factor(loan_status), y = .data[[var]])) +
    geom_boxplot(fill = "lightblue") + 
    labs(title = paste("Distribución de", var, "según el Estado del Préstamo"),
         x = "Estado del Préstamo", 
         y = var) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  print(p)
}

Estos plots son muy importantes, ya que vemos como hay determinadas variables que cambian o se adaptan de forma muy interesante con respecto a la variable "target". Estados como Fully Paid muestran distribuciones esperadas, con altos valores tanto en pagos totales como en recuperación de principal por ejemplo, destacando que el préstamo fue exitoso. Estados de incumplimiento (Charged Off, Default) y demora (Late) tienen valores bajos en ambas métricas, lo que refleja menores pagos realizados y recuperación limitada del principal. El estado Current tiene una variabilidad alta en estas dos métricas comparadas, mostrando que algunos prestatarios están cerca de completar sus pagos, mientras que otros están más rezagados.

  1. Creación de la variable objetivo y clasificación de los datos.

Transformamos la columna loan_status en una variable objetivo target con cinco categorías. Las muestras que se hallan en un estado diferente a esas cinco categorías etiquetadas, las eliminamos. Nos quedamos en este punto con 1,379,602 muestras.

data <- data %>%
  mutate(target = case_when(
    loan_status == "Fully Paid" ~ 0,
    loan_status == "In Grace Period" ~ 1,
    loan_status == "Late (16-30 days)" ~ 2,
    loan_status == "Late (31-120 days)" ~ 3,
    loan_status %in% c("Charged Off", "Default") ~ 4,
    TRUE ~ NA_real_
  )) %>%
  select(-loan_status) %>%
  filter(!is.na(target))

Fully Paid (Totalmente Pagado): El préstamo ha sido pagado en su totalidad, lo que significa que el prestatario cumplió con todos los pagos acordados según el contrato del préstamo.

In Grace Period (En Período de Gracia): El prestatario está en un período de gracia, que es un tiempo adicional otorgado para realizar el pago antes de que se considere en mora. Durante este período, el prestatario no incurre en penalizaciones.

Late (16-30 days) (Tarde 16-30 días): El préstamo está en mora, ya que el prestatario no ha realizado el pago correspondiente dentro del plazo. Este estado indica que el pago se ha retrasado entre 16 y 30 días.

Late (31-120 days) (Tarde 31-120 días): El préstamo continúa en mora, pero el retraso es más significativo, entre 31 y 120 días. Este estado puede afectar negativamente la calificación crediticia del prestatario.

Charged Off (Cobrada como Pérdida) / Default (Incumplimiento): Este estado indica que el prestamista ha determinado que el préstamo es incobrable y lo ha dado de baja como pérdida (charged off) después de múltiples intentos de cobranza. Esto puede ocurrir después de un período prolongado de impago, generalmente de 120 días o más.

4.1. Clustering llevado a cabo con los datos filtrados y preprocesados hasta el momento.

variables_numericas <- data %>%
  select_if(is.numeric) %>%
  select(-target)

datos_normalizados <- scale(variables_numericas)

filas_completas <- complete.cases(datos_normalizados)

datos_normalizados <- datos_normalizados[filas_completas, ]
target_filtrado <- data$target[filas_completas]

data_muestreo <- data.frame(datos_normalizados, target = target_filtrado)

muestras_por_clase <- 200  

data_muestreada <- data_muestreo %>%
  group_by(target) %>%
  sample_n(muestras_por_clase)

datos_normalizados_muestreado <- data_muestreada %>%
  select(-target) 
## Adding missing grouping variables: `target`
target_filtrado_muestreado <- data_muestreada$target

nrow(datos_normalizados_muestreado)
## [1] 1000
length(target_filtrado_muestreado)
## [1] 1000
num_clusters <- 5
n_iterations <- 25

kmeans_result <- list()

for (i in 1:n_iterations) {
  kmeans_result[[i]] <- kmeans(datos_normalizados_muestreado, centers = num_clusters, nstart = 1)
}

best_kmeans <- kmeans_result[[which.min(sapply(kmeans_result, function(x) x$tot.withinss))]]

pca_result <- prcomp(datos_normalizados_muestreado)

resultados <- data.frame(
  PC1 = pca_result$x[,1],
  PC2 = pca_result$x[,2],
  Cluster = as.factor(best_kmeans$cluster),
  Target = as.factor(target_filtrado_muestreado)
)

plot <- ggplot(resultados, aes(x = PC1, y = PC2, color = Target, shape = Cluster)) +
  geom_point(size = 3, alpha = 0.7) +
  theme_minimal() +
  labs(title = "Clustering K-means coloreado por Target",
       x = "Primera Componente Principal",
       y = "Segunda Componente Principal") +
  scale_color_discrete(name = "Target") +
  scale_shape_discrete(name = "Cluster")

print(plot)

tabla_comparacion <- table(best_kmeans$cluster, target_filtrado_muestreado)
print(tabla_comparacion)
##    target_filtrado_muestreado
##       0   1   2   3   4
##   1  65   9   6   3  22
##   2  99  57  66  53 103
##   3  36  19  25  28  75
##   4   0  80  72  71   0
##   5   0  35  31  45   0
prop_tabla <- prop.table(tabla_comparacion, margin = 1)
print(prop_tabla)
##    target_filtrado_muestreado
##              0          1          2          3          4
##   1 0.61904762 0.08571429 0.05714286 0.02857143 0.20952381
##   2 0.26190476 0.15079365 0.17460317 0.14021164 0.27248677
##   3 0.19672131 0.10382514 0.13661202 0.15300546 0.40983607
##   4 0.00000000 0.35874439 0.32286996 0.31838565 0.00000000
##   5 0.00000000 0.31531532 0.27927928 0.40540541 0.00000000

Importante: Los clusters aparecen enumerado del 1 al 5 y nuestras categorías del 0 al 4.

Como vemos en este clustering (subset de 200 muestras por clase), y en las tablas de resultados, fundamentalmente se clasifican bien las categorías más extremas, es decir, los "Fully paid" (0) o los clientes "Charged Off" o "Default" (4), mientras en los restantes (pagos tardíos) parece que hay bastante confusión. A pesar de ello, que el 86% de las muestras de la categoría "Fully paid" clasifiquen en un mismo cluster parece un dato bastante bueno, y que demuestra que las variables aisladas empiezan a aportar información clave de cara al cumplimiento de nuestro objetivo clave, es decir, la elaboración de un modelo que distinga las 5 categorías propuestas de pago/impago de préstamos.

  1. Distribución de la variable objetivo.

Visualizamos la distribución de la variable objetivo.

pie_data <- data %>%
  group_by(target) %>%
  summarise(count = n()) %>%
  mutate(label = c("Fully Paid", "In Grace Period", "Late (16-30 days)", 
                   "Late (31-120 days)", "Charged Off / Default")[target + 1]) %>%
  mutate(percentage = count / sum(count) * 100,
         label_text = paste0(label, " (", round(percentage, 1), "%)"))

custom_colors <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd")

p <- plot_ly(pie_data, labels = ~label, values = ~count, type = 'pie',
             textposition = 'inside',
             textinfo = 'label+percent',
             insidetextfont = list(color = '#FFFFFF'),
             hoverinfo = 'text',
             text = ~paste(label, "<br>", count, "préstamos"),
             marker = list(colors = custom_colors,
                           line = list(color = '#FFFFFF', width = 1)),
             showlegend = FALSE) %>%
  layout(title = "Distribución de la Variable Objetivo",
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

p
Fully Paid78%Charged Off / Default19.5%Late (31-120 days)1.56%In Grace Period0.611%Late (16-30 days)0.315%
Distribución de la Variable Objetivo

Se observa como hay un elevadísimo porcentaje (78%) de préstamos pagados, y también un porcentaje importante (del 19,5% después del último filtrado de muestras), de préstamos no pagados.

  1. Análisis de la importancia de las características.

Entrenamos un modelo Random Forest (autoexplicativo) para evaluar la importancia de las características. De este modo seleccionaremos las variables clave para la red neuronal que posteriormente diseñaremos.

num_cores <- detectCores() - 1
num_cores
## [1] 7
cl <- makeCluster(num_cores)
registerDoParallel(cl)
response_var <- "target"
features <- setdiff(colnames(data), response_var)
data_subset <- na.omit(data[, c(features, response_var)])

reduce_categories <- function(x, top_n = 50) {
     if (is.factor(x) && nlevels(x) > 53) {
         top_levels <- names(sort(table(x), decreasing = TRUE)[1:top_n])
         return(factor(ifelse(x %in% top_levels, as.character(x), "Other")))
     }
     return(x)
}
data_subset <- data_subset %>% mutate(across(where(is.factor), ~reduce_categories(.)))
factor_cols <- sapply(data_subset, is.factor)
sapply(data_subset[, factor_cols], nlevels)
##                  id                term               grade           sub_grade 
##                  51                   3                   8                  36 
##           emp_title          emp_length      home_ownership verification_status 
##                  51                  12                   7                   4 
##             issue_d                 url             purpose               title 
##                  37                  51                  15                  14 
##            zip_code          addr_state    earliest_cr_line initial_list_status 
##                  51                  52                  51                   3 
##        last_pymnt_d        next_pymnt_d  last_credit_pull_d    application_type 
##                  41                   5                  42                   3 
##            id_top10     sub_grade_top10     emp_title_top10    emp_length_top10 
##                  11                  11                  11                  11 
##       issue_d_top10 
##                  11
rf_model <- foreach(ntree = rep(floor(500/num_cores), num_cores), 
                     .combine = randomForest::combine, 
                     .packages = "randomForest") %dopar% {
                         randomForest(as.factor(target) ~ ., 
                                      data = data_subset, 
                                      ntree = ntree,
                                      importance = TRUE)
                     }

stopCluster(cl)

Para ejecutar el proceso de forma eficiente, generamos un subset de los datos sin NAs, y además paralelizamos el proceso.

print(rf_model)
## 
## Call:
##  randomForest(formula = as.factor(target) ~ ., data = data_subset,      ntree = ntree, importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 497
## No. of variables tried at each split: 9
importance_scores <- importance(rf_model)
sorted_importance <- sort(importance_scores[, "MeanDecreaseGini"], decreasing = TRUE)

varImpPlot(rf_model, main = "Variable Importance",  cex = 0.6)

importance_df <- data.frame(
    variable = names(sorted_importance[1:30]),
    importance = sorted_importance[1:30]
)

ggplot(importance_df, aes(x = reorder(variable, importance), y = importance)) +
    geom_bar(stat = "identity", fill = "skyblue") +
    coord_flip() +  # Flip coordinates to make horizontal bars
    theme_minimal() +
    labs(
        title = "Top 30 Most Important Variables",
        x = "Variables",
        y = "Importance"
    ) +
    theme(
        axis.text.y = element_text(size = 8),  # Adjust text size for y-axis labels
        plot.margin = unit(c(1, 1, 1, 1), "cm")  # Add margins using unit()
    )

sorted_importance[1:30]
##  last_fico_range_low last_fico_range_high      last_pymnt_amnt 
##           29393.2570           28774.1436           24524.5504 
##      total_rec_prncp         next_pymnt_d        out_prncp_inv 
##           22396.6415            9491.3941            8428.7120 
##      total_pymnt_inv            out_prncp          total_pymnt 
##            8096.4022            7964.2958            7733.9846 
##         last_pymnt_d          funded_amnt      funded_amnt_inv 
##            5015.5107            4719.9391            4224.1246 
##            loan_amnt          installment        total_rec_int 
##            4183.0644            3658.3711            2079.9042 
##             int_rate   last_credit_pull_d                grade 
##            1143.4162            1043.4005            1009.3591 
##              issue_d            sub_grade                 term 
##             901.8886             806.3430             687.2349 
##           addr_state      sub_grade_top10           emp_length 
##             687.2233             382.9835             336.4421 
##     emp_length_top10     earliest_cr_line             zip_code 
##             320.7056             314.7854             296.5549 
##                  dti      fico_range_high       fico_range_low 
##             294.6912             294.1019             291.9964
#saveRDS(rf_model, file = "rf_model.rds")
# loaded_model <- readRDS("rf_model.rds")

Observamos qué variables tienen más importancia en la predicción del estado en el que se encuentra el préstamo y aislamos entre las 30 más relevantes, las que tomemos para entrenar el modelo en cuestión.

  1. last_fico_range_high: El límite superior del rango en el que cae la última puntuación FICO del prestatario.
  2. last_fico_range_low: El límite inferior del rango en el que cae la última puntuación FICO del prestatario.
  3. last_pymnt_amnt: El último monto total de pago recibido del prestatario.
  4. total_rec_prncp: El monto total del principal recibido hasta la fecha.
  5. out_prncp: Principal pendiente restante del monto total financiado.
  6. total_pymnt: El monto total pagado por el prestatario hasta la fecha.
  7. total_pymnt_inv: El monto total pagado por el prestatario hasta la fecha para la parte del monto total financiado por los inversores.
  8. out_prncp_inv: Principal pendiente restante de la parte del monto total financiado por los inversores.
  9. funded_amnt: El monto total comprometido para el préstamo en ese momento.
  10. loan_amnt: El monto del préstamo solicitado por el prestatario.
  11. funded_amnt_inv: El monto total comprometido por los inversores para ese préstamo en ese momento.
  12. installment: El pago mensual que debe el prestatario si el préstamo es originado.
  13. total_rec_int: El monto total de intereses recibidos hasta la fecha.
  14. int_rate: La tasa de interés del préstamo.
  15. grade: La calificación del préstamo asignada por LC.
  16. fico_range_high: El límite superior del rango en el que se encuentra la puntuación FICO del prestatario, utilizado para evaluar su riesgo crediticio.
  17. fico_range_low: El límite inferior del rango en el que se encuentra la puntuación FICO del prestatario, que ayuda a determinar la elegibilidad para el préstamo.
  18. emp_length: La duración del empleo del prestatario, generalmente expresada en años, que puede influir en su capacidad de pago. 19: dti: La relación entre la deuda y los ingresos del prestatario, que mide el porcentaje de los ingresos mensuales que se destinan al pago de deudas.

Finalmente, filtramos con las variables seleccionadas anteriormente, y normalizamos y escalamos los datos:

top_30_vars <- names(sorted_importance[1:30])

numeric_vars <- sapply(data[, top_30_vars], is.numeric)

print(numeric_vars)
##  last_fico_range_low last_fico_range_high      last_pymnt_amnt 
##                 TRUE                 TRUE                 TRUE 
##      total_rec_prncp         next_pymnt_d        out_prncp_inv 
##                 TRUE                FALSE                 TRUE 
##      total_pymnt_inv            out_prncp          total_pymnt 
##                 TRUE                 TRUE                 TRUE 
##         last_pymnt_d          funded_amnt      funded_amnt_inv 
##                FALSE                 TRUE                 TRUE 
##            loan_amnt          installment        total_rec_int 
##                 TRUE                 TRUE                 TRUE 
##             int_rate   last_credit_pull_d                grade 
##                 TRUE                FALSE                FALSE 
##              issue_d            sub_grade                 term 
##                FALSE                FALSE                FALSE 
##           addr_state      sub_grade_top10           emp_length 
##                FALSE                FALSE                FALSE 
##     emp_length_top10     earliest_cr_line             zip_code 
##                FALSE                FALSE                FALSE 
##                  dti      fico_range_high       fico_range_low 
##                 TRUE                 TRUE                 TRUE
numeric_var_names <- names(numeric_vars[numeric_vars])
print("Numeric variables:")
## [1] "Numeric variables:"
print(numeric_var_names)
##  [1] "last_fico_range_low"  "last_fico_range_high" "last_pymnt_amnt"     
##  [4] "total_rec_prncp"      "out_prncp_inv"        "total_pymnt_inv"     
##  [7] "out_prncp"            "total_pymnt"          "funded_amnt"         
## [10] "funded_amnt_inv"      "loan_amnt"            "installment"         
## [13] "total_rec_int"        "int_rate"             "dti"                 
## [16] "fico_range_high"      "fico_range_low"
selected_vars <- c(numeric_var_names, "grade", "emp_length")

data_filtered <- data[, c(selected_vars, "target")]

data_filtered <- cbind(data_filtered, model.matrix(~ grade + emp_length - 1, data = data_filtered))

new_columns <- colnames(data_filtered)[grepl("grade|emp_length", colnames(data_filtered))]
selected_vars <- c(numeric_var_names, new_columns)

preprocess_params <- preProcess(data_filtered[, selected_vars], method = c("center", "scale"))
data_normalized <- predict(preprocess_params, data_filtered[, selected_vars])

data_final <- cbind(data_normalized, target = data_filtered$target)

data_final$target <- as.factor(data_final$target)

print(dim(data_final))
## [1] 1379602      39
print(names(data_final))
##  [1] "last_fico_range_low"  "last_fico_range_high" "last_pymnt_amnt"     
##  [4] "total_rec_prncp"      "out_prncp_inv"        "total_pymnt_inv"     
##  [7] "out_prncp"            "total_pymnt"          "funded_amnt"         
## [10] "funded_amnt_inv"      "loan_amnt"            "installment"         
## [13] "total_rec_int"        "int_rate"             "dti"                 
## [16] "fico_range_high"      "fico_range_low"       "grade"               
## [19] "emp_length"           "grade.1"              "gradeA"              
## [22] "gradeB"               "gradeC"               "gradeD"              
## [25] "gradeE"               "gradeF"               "gradeG"              
## [28] "emp_length< 1 year"   "emp_length1 year"     "emp_length10+ years" 
## [31] "emp_length2 years"    "emp_length3 years"    "emp_length4 years"   
## [34] "emp_length5 years"    "emp_length6 years"    "emp_length7 years"   
## [37] "emp_length8 years"    "emp_length9 years"    "target"
write.csv(data_final, file = "data_credit_risk_neural_network_rmd.csv", row.names = FALSE)

Ya tenemos una matriz de datos preparada y guardada para entrenar nuestro modelo de red neuronal.

  1. Modelo KNN (K-Neirest Neighbor)

Entrenamos un modelo de agrupamiento utilizando el algoritmo KNN (K-Nearest Neighbors) sobre los datos previamente filtrados, escalados y normalizados. Este proceso nos permitirá evaluar la capacidad del modelo para clasificar las muestras en sus respectivos grupos, midiendo así la precisión y efectividad del algoritmo en la identificación de patrones y relaciones dentro de los datos.

data_final <- read.csv("data_credit_risk_neural_network_rmd.csv")

variables_numericas <- data_final %>%
     dplyr::select_if(is.numeric) %>%
     dplyr::select(-target)

 datos_normalizados <- variables_numericas
 filas_completas <- complete.cases(datos_normalizados)
 datos_normalizados <- datos_normalizados[filas_completas, ]
 target_filtrado <- data_final$target[filas_completas]
 
 set.seed(123) 
 indices <- createDataPartition(target_filtrado, p = 0.8, list = FALSE)
 datos_train <- datos_normalizados[indices, ]
 datos_test <- datos_normalizados[-indices, ]
 target_train <- target_filtrado[indices]
 target_test <- target_filtrado[-indices]
 
 num_cores <- parallel::detectCores() - 1 
 cl <- makeCluster(num_cores)
 registerDoParallel(cl)
 
 k_values <- c(3, 5, 7)  
 knn_results <- foreach(k = k_values, .combine = rbind, .packages = "class") %dopar% {
     knn_pred <- knn(train = datos_train, test = datos_test, cl = target_train, k = k)
     conf_matrix <- table(Predicted = knn_pred, Actual = target_test)
     accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
     data.frame(k = k, Accuracy = accuracy)
 }
 print(knn_results)
##   k  Accuracy
## 1 3 0.9689963
## 2 5 0.9694168
## 3 7 0.9693443
save(datos_train, target_train, file = "knn_model_data.RData")

 pca_test <- prcomp(datos_test)
 pca_test_df <- data.frame(PC1 = pca_test$x[, 1], PC2 = pca_test$x[, 2])

 k <- 5  
 knn_pred <- knn(train = datos_train, test = datos_test, cl = target_train, k = k)
 
 pca_test_df$True_Label <- as.factor(target_test)
 pca_test_df$Predicted_Label <- as.factor(knn_pred)
 
 plot <- ggplot(pca_test_df, aes(x = PC1, y = PC2)) +
     geom_point(aes(color = True_Label, shape = Predicted_Label), size = 3, alpha = 0.7) +
     theme_minimal() +
     labs(
         title = "Clustering of Test Data (KNN Predictions)",
         x = "First Principal Component",
         y = "Second Principal Component"
     ) +
     scale_color_discrete(name = "True Label") +
     scale_shape_discrete(name = "Predicted Label")
 
 print(plot)

umap_config <- umap.defaults
umap_config$n_neighbors <- 15  
umap_config$min_dist <- 0.1   
umap_config$metric <- "euclidean"

datos_test_matrix <- as.matrix(datos_test)

umap_test <- umap(
    X = datos_test_matrix,
    n_neighbors = 15,
    min_dist = 0.1,   
    metric = "euclidean",
    n_components = 3,  
    n_threads = parallel::detectCores() - 1  
)

umap_test_df <- data.frame(
    UMAP1 = umap_test[, 1],
    UMAP2 = umap_test[, 2],
    UMAP3 = umap_test[, 3],
    True_Label = as.factor(target_test)  
)

k <- 5 
knn_pred <- knn(train = datos_train, test = datos_test, cl = target_train, k = k)

umap_test_df$Predicted_Label <- as.factor(knn_pred)

set.seed(123)  
sampled_data <- umap_test_df %>%
  group_by(True_Label) %>%
  sample_n(min(50, n())) %>% 
  ungroup()

plot <- plot_ly(sampled_data, 
                x = ~UMAP1, y = ~UMAP2, z = ~UMAP3, 
                color = ~True_Label,                 
                symbol = ~Predicted_Label,           
                type = 'scatter3d', 
                mode = 'markers',
                marker = list(size = 5, opacity = 0.7)) %>%
  layout(
    title = "3D UMAP Clustering of Test Data (KNN Predictions)",
    scene = list(
      xaxis = list(title = "UMAP Dimension 1"),
      yaxis = list(title = "UMAP Dimension 2"),
      zaxis = list(title = "UMAP Dimension 3")
    )
  )
#htmlwidgets::saveWidget(
#  widget = plot, 
#  file = "umap_knn_plot.html", 
#  selfcontained = TRUE  
#)

Como podemos observar, la precisión del modelo es muy alta (en torno al 97%). Además hemos representado un plot en 3 dimensiones con UMAP (Uniform Manifold Approximation and Projection), en el que se observa la disposición de los clientes con las etiquetas reales y predichas en este enlace, así como solamente con las etiquetas del cluster al que se predice que pertenecen (ver aquí). Con todo esto, tomamos la matriz normalizada, escalada y limpia, y entrenaremos otro modelo de redes neuronales más complejo, en pro de ver la precisión del mismo y usarlo de forma interactiva en una web montada con R Shiny.